home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / outlook / OutlookHelper / Outlook.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-08-12  |  8.7 KB  |  270 lines
  1. Unit Outlook;
  2.  
  3. Interface
  4.  
  5. Uses Outlook8;
  6.  
  7. Const
  8.   CRLF = #13#10;
  9.  
  10. Type
  11.   CalendarCache = Array[1..31] of String;
  12.  
  13.   TOutlookObjects = Class(TObject)
  14.   Protected
  15.     nsMAPI         : NameSpace;
  16.     { calendar }
  17.     mfCalendar     : MAPIFolder;
  18.     itAppointments : Items;
  19.     ccCurrentMonth : CalendarCache;
  20.     iCacheYear     : Integer;
  21.     iCacheMonth    : Integer;
  22.     { contacts }
  23.     mfContacts     : MAPIFolder;
  24.     itContacts     : Items;
  25.     { tasks }
  26.     mfTasks        : MAPIFolder;
  27.     itTasks        : Items;
  28.     { Notes }
  29.     mfNotes        : MAPIFolder;
  30.     itNotes        : Items;
  31.     { Inbox }
  32.     mfInbox        : MAPIFolder;
  33.     itInbox        : Items;
  34.     Procedure CheckApplicationConnection;
  35.     Procedure BuildCalendarCache(iYear,iMonth : Integer);
  36.     Function FixStringIfNotEmpty(strString : String; strPrefix : String = '') : String;
  37.   Public
  38.     Constructor Create;
  39.     Procedure Free;
  40.     Function GetAppointmentsOn(iYear,iMonth,iDay : Integer) : String;
  41.     Function GetContactCount : Integer;
  42.     Function GetContactDetails(iContactNumber : Integer) : String;
  43.     Function GetTaskCount : Integer;
  44.     Function GetTaskDetails(iTaskNumber : Integer) : String;
  45.     Function GetNoteCount : Integer;
  46.     Function GetNoteDetails(iNoteNumber : Integer) : String;
  47.     Function GetInboxMessageCount : Integer;
  48.     Function GetInboxMessageDetails(iMessageNumber : Integer) : String;
  49.   End;
  50.  
  51. Implementation
  52.  
  53. { TOutlookObjectsCalendar }
  54.  
  55. Uses SysUtils,Windows,OLEServer,MainForm;
  56.  
  57. Var
  58.   oaApplication : TOutlookApplication;
  59.  
  60. Constructor TOutlookObjects.Create;
  61. Begin
  62.   CheckApplicationConnection;
  63.   Try { navigate to the appropriate objects }
  64.     With oaApplication do Begin
  65.       nsMAPI := GetNamespace('MAPI');
  66.       nsMAPI.Logon('',EmptyParam,EmptyParam,EmptyParam); { logon as default user }
  67.       mfCalendar := nsMAPI.GetDefaultFolder(olFolderCalendar);
  68.       itAppointments := mfCalendar.Items;
  69.       mfContacts := nsMAPI.GetDefaultFolder(olFolderContacts);
  70.       itContacts := mfContacts.Items;
  71.       mfTasks := nsMAPI.GetDefaultFolder(olFolderTasks);
  72.       itTasks := mfTasks.Items;
  73.       mfNotes := nsMAPI.GetDefaultFolder(olFolderNotes);
  74.       itNotes := mfNotes.Items;
  75.       mfInbox := nsMAPI.GetDefaultFolder(olFolderInbox);
  76.       itInbox := mfInbox.Items;
  77.     End;
  78.   Except
  79.     Fail; { fail the constructor }
  80.   End;
  81. End;
  82.  
  83. Procedure TOutlookObjects.Free;
  84. Begin
  85.   Try
  86.     { free all interfaces }
  87.     itAppointments := nil;
  88.     mfCalendar := nil;
  89.     itContacts := nil;
  90.     mfContacts := nil;
  91.     nsMAPI.Logoff;
  92.     nsMAPI := nil;
  93.   Except
  94.     MessageBeep(0);
  95.   End;
  96.   If (oaApplication <> nil) Then Begin
  97.     oaApplication.Disconnect;
  98.     oaApplication.Free;
  99.   End;
  100. End;
  101.  
  102. Procedure TOutlookObjects.CheckApplicationConnection;
  103. Begin
  104.   If (oaApplication = nil) Then Begin
  105.     oaApplication := TOutlookApplication.Create(nil);
  106.     oaApplication.ConnectKind := ckRunningOrNew;
  107.     oaApplication.Connect;
  108.   End;
  109. End;
  110.  
  111. Procedure TOutlookObjects.BuildCalendarCache(iYear,iMonth : Integer);
  112. Var
  113.   iIndex,iDay : Integer;
  114.   aiItem      : AppointmentItem;
  115.   dtFirstDay  : TDateTime;
  116.   dtLastDay   : TDateTime;
  117.   wY,wM,wD    : Word;
  118.   iStart,IEnd : Integer;
  119.   strSubject  : String;
  120.  
  121.   Function GetRealEndDate : TDateTime;
  122.   Begin
  123.     Result := aiItem.End_;
  124.     { all-day events end at next day 00:00 so decrement the day number }
  125.     If aiItem.AllDayEvent Then Result := Result-1;
  126.   End;
  127.  
  128.   Function OccursInTheGivenMonth : Boolean;
  129.   Begin
  130.     Result := False;
  131.     If ((aiItem.Start < dtFirstDay) And (GetRealEndDate < dtFirstDay)) Then Exit; { occurs in the past }
  132.     If (aiItem.Start > dtLastDay) Then Exit; { occurs in the future }
  133.     Result := True;
  134.   End;
  135.  
  136. Begin
  137.   { do we need to build the cache? }
  138.   If ((iYear <> iCacheYear) Or (iMonth <> iCacheMonth)) Then Begin
  139.     Try
  140.       { first clear the cache }
  141.       For iIndex := 1 to 31 do ccCurrentMonth[iIndex] := '';
  142.       { start and end dates for the given iMonth }
  143.       dtFirstDay := EncodeDate(iYear,iMonth,1);
  144.       dtLastDay := EncodeDate(iYear,iMonth,MonthDays[IsLeapYear(iYear),iMonth]);
  145.       { then build the cache by enumerating all appointments }
  146.       For iIndex := 1 to itAppointments.Count do Begin
  147.         aiItem := AppointmentItem(itAppointments.Item(iIndex)); { typecast }
  148.         { does the appointment occur in the given iMonth? }
  149.         If OccursInTheGivenMonth Then Begin
  150.           { decode the start and end dates }
  151.           DecodeDate(aiItem.Start,wY,wM,wD);
  152.           { did the event start in the past iMonth(s)? }
  153.           If (wM < iMonth) Then iStart := 1
  154.           Else iStart := wD;
  155.           DecodeDate(GetRealEndDate,wY,wM,wD);
  156.           { did the event end in the future iMonth(s)? }
  157.           If (wM > iMonth) Then iEnd := MonthDays[IsLeapYear(iYear),iMonth]
  158.           Else iEnd := wD;
  159.           { save the appointment in the cache }
  160.           strSubject := aiItem.Subject;
  161.           For iDay := iStart to iEnd do
  162.             ccCurrentMonth[iDay] := ccCurrentMonth[iDay]+strSubject+'<BR>';
  163.         End;
  164.         aiItem := nil;
  165.       End;
  166.       { save the currently caches time period }
  167.       iCacheYear := iYear;
  168.       iCacheMonth := iMonth;
  169.     Finally
  170.       aiItem := nil;  
  171.     End;
  172.   End;
  173. End;
  174.  
  175. Function TOutlookObjects.GetAppointmentsOn(iYear,iMonth,iDay : Integer) : String;
  176. Begin
  177.   BuildCalendarCache(iYear,iMonth);
  178.   Result := ccCurrentMonth[iDay];
  179. End;
  180.  
  181. Function TOutlookObjects.FixStringIfNotEmpty(strString : String; strPrefix : String = '') : String;
  182. Begin
  183.   If (strString <> '') Then strString := strPrefix+strString+'<BR>'+CRLF;
  184.   Result := strString;
  185. End;
  186.  
  187. Function TOutlookObjects.GetContactCount : Integer;
  188. Begin
  189.   Result := itContacts.Count;
  190. End;
  191.  
  192. Function TOutlookObjects.GetContactDetails(iContactNumber : Integer) : String;
  193. Var ciItem : ContactItem;
  194. Begin
  195.   ciItem := ContactItem(itContacts.Item(iContactNumber+1));
  196.   Result := '<B>'+ciItem.FileAs+'</B><BR>'+CRLF+
  197.             FixStringIfNotEmpty(ciItem.CompanyName)+
  198.             FixStringIfNotEmpty(ciItem.MailingAddress)+
  199.             FixStringIfNotEmpty(ciItem.BusinessTelephoneNumber,'b. ')+
  200.             FixStringIfNotEmpty(ciItem.HomeTelephoneNumber,'h. ')+
  201.             FixStringIfNotEmpty(ciItem.MobileTelephoneNumber,'m. ')+
  202.             '<A HREF="mailto:'+ciItem.Email1Address+'">'+ciItem.Email1Address+'</A><BR> ';
  203. End;
  204.  
  205. Function TOutlookObjects.GetTaskCount : Integer;
  206. Begin
  207.   Result := itTasks.Count;
  208. End;
  209.  
  210. Function TOutlookObjects.GetTaskDetails(iTaskNumber : Integer) : String;
  211. Const
  212.   cstrTaskStatuses : Array[olTaskNotStarted..olTaskDeferred] of String =
  213.                     ('Not started','In progress','Complete','Waiting','Deferred');
  214.  
  215. Var
  216.   tiItem : TaskItem;
  217.  
  218.   Function SafeDateToStr(dtDate : TDateTime) : String;
  219.   Begin
  220.     If (dtDate < 1) Then Result := '' { don't show dates from 19th century }
  221.     Else Result := DateToStr(dtDate);
  222.   End;
  223.  
  224. Begin
  225.   tiItem := TaskItem(itTasks.Item(iTaskNumber+1));
  226.   Result := '<B>'+tiItem.Subject+'</B><BR>'+CRLF+
  227.             FixStringIfNotEmpty(SafeDateToStr(tiItem.DueDate),'Due: ')+
  228.             FixStringIfNotEmpty(SafeDateToStr(tiItem.StartDate),'Start: ')+
  229.             cstrTaskStatuses[Integer(tiItem.Status)]+'<BR>'+CRLF+
  230.             'Complete: '+IntToStr(tiItem.PercentComplete)+'%<BR>'+CRLF;
  231. End;
  232.  
  233. Function TOutlookObjects.GetNoteCount : Integer;
  234. Begin
  235.   Result := itNotes.Count;
  236. End;
  237.  
  238. Function TOutlookObjects.GetNoteDetails(iNoteNumber : Integer) : String;
  239. Var niItem : NoteItem;
  240. Begin
  241.   niItem := NoteItem(itNotes.Item(iNoteNumber+1));
  242.   Result := '    <TD WIDTH="30%"><FONT FACE="Arial, Helvetica, sans-serif" SIZE="2"><B>'+
  243.             niItem.Subject+'</B></FONT></TD>'+CRLF+
  244.             '    <TD WIDTH="70%"><PRE><FONT FACE="Arial, Helvetica, sans-serif" SIZE="2">'+
  245.             niItem.Body+'</FONT></PRE></TD>'+CRLF;
  246. End;
  247.  
  248. Function TOutlookObjects.GetInboxMessageCount : Integer;
  249. Begin
  250.   Result := itInbox.Count;
  251. End;
  252.  
  253. Function TOutlookObjects.GetInboxMessageDetails(iMessageNumber : Integer) : String;
  254. Var miItem : MailItem;
  255. Begin
  256.   miItem := MailItem(itInbox.Item(iMessageNumber+1));
  257.   Result := '  <TR BGCOLOR="#EEEEEE">'+CRLF+
  258.             '    <TD><FONT FACE="Arial, Helvetica, sans-serif" SIZE="2"><B>From: '+
  259.             miItem.SenderName+'</B><BR>'+CRLF+
  260.             '      Subject: '+miItem.Subject+'<BR>'+CRLF+
  261.             '      Received: '+DateTimeToStr(miItem.ReceivedTime)+'</FONT></TD>'+CRLF+
  262.             '  </TR>'+CRLF+
  263.             '  <TR>'+CRLF+
  264.             '    <TD><PRE><FONT FACE="Arial, Helvetica, sans-serif" SIZE="2">'+
  265.             miItem.Body+'</FONT></PRE></TD>'+CRLF+
  266.             '  </TR>'+CRLF;
  267. End;
  268.  
  269. End.
  270.